home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / opbonus.arc / UNITINFO.ARC / UNITINFO.PAS < prev   
Pascal/Delphi Source File  |  1991-03-20  |  9KB  |  241 lines
  1. {$S-,I-}
  2.  
  3. {*********************************************************}
  4. {*                   UNITINFO.PAS 1.2                    *}
  5. {*    Copyright (c) TurboPower Software 1989,1990.       *}
  6. {*                 All rights reserved.                  *}
  7. {*********************************************************}
  8.  
  9. program UnitInfo;
  10.   {-Display information about a 5.5 or 6.0 TPU file}
  11. uses
  12.   Dos, OpString, OpDos;
  13. type
  14.   SigType = array[1..4] of Char; {a TPU header signature}
  15. const
  16.  {$IFDEF Ver60}
  17.   SigForTPU60 : SigType = 'TPU9'; {signature for 6.0 TPU files}
  18.  {$ELSE}
  19.   SigForTPU55 : SigType = 'TPU6'; {signature for 5.5 TPU files}
  20.  {$ENDIF}
  21.   DebugOnly : Boolean = False;
  22.   LocalsOnly : Boolean = False;
  23.   NumericOnly : Boolean = False;
  24.   OverlayOnly : Boolean = False;
  25.   ShowSymSize : Boolean = False;
  26. type
  27.  {$IFDEF Ver60}
  28.   TpuHeader =                {format of the TPU header: 6.0 only}
  29.     record
  30.       TPUsig : SigType;      {"TPU9" signature}
  31.       NextUnit,              {segment in memory for next unit}
  32.       NextLibrary,           {segment in memory for next library}
  33.       UsesPtr,               {offset to unit name/symbol table}
  34.       ScopePtr,              {offset to hash table}
  35.       ProcPtr,               {offset to procedure table}
  36.       GroupPtr,              {offset to Group table}
  37.       ConGrPtr,              {Const group table pointer}
  38.       DatGrPtr,              {Data group table pointer}
  39.       LinkPtr,               {offset to link names table}
  40.       DunnoPtr,
  41.       NamePtr,               {offset to filename table}
  42.       DebugPtr,              {offset to line number table}
  43.       UnitSize,              {symbol table size}
  44.       CodeSize,              {total code (bytes)}
  45.       ConstSize,             {initialized data (bytes)}
  46.       FixupSize,             {size of code fixup table}
  47.       ConFixSize,            {size of constant fixup section}
  48.       DataSize,              {uninitialized data (bytes)}
  49.       DScopePtr,             {debug scope pointer}
  50.       Flags,                 {1 if unit compiled with $N+, 2 if $O+}
  51.       ExecBase,              {relative code segment}
  52.       ExecSize,              {code used (bytes)}
  53.       OvLaySize : Word;      {overlay code size}
  54.       Private : array[1..8] of Word;
  55.     end;
  56.  {$ELSE}
  57.   TpuHeader =                {format of the TPU header: 5.5 only}
  58.     record
  59.       TPUsig : SigType;      {"TPU6" signature}
  60.       NextUnit,              {segment in memory for next unit}
  61.       NextLibrary,           {segment in memory for next library}
  62.       UsesPtr,               {offset to unit name/symbol table}
  63.       ScopePtr,              {offset to hash table}
  64.       ProcPtr,               {offset to procedure table}
  65.       GroupPtr,              {offset to Group table}
  66.       ConGrPtr,              {Const group table pointer}
  67.       DatGrPtr,              {Data group table pointer}
  68.       LinkPtr,               {offset to link names table}
  69.       NamePtr,               {offset to filename table}
  70.       DebugPtr,              {offset to line number table}
  71.       UnitSize,              {symbol table size}
  72.       CodeSize,              {total code (bytes)}
  73.       ConstSize,             {initialized data (bytes)}
  74.       ConFixSize,            {size of the constant fixup section}
  75.       FixupSize,             {size of fixup table (follows code in TPU)}
  76.       DataSize,              {uninitialized data (bytes)}
  77.       DScopePtr,             {debug scope pointer}
  78.       Flags,                 {1 if unit compiled with $N+, 2 if $O+}
  79.       ExecBase,              {relative code segment}
  80.       ExecSize,              {code used (bytes)}
  81.       OvLaySize,             {overlay code size}
  82.       {...}
  83.       FilePtr,               {???}
  84.       CodeSeg,               {segment for code (while compiling)}
  85.       FixupSeg,              {segment for relocation table (while compiling)}
  86.       ConstSeg,              {segment for initialized data (while compiling)}
  87.       FixupCnt,              {fixup group count}
  88.       RelocCnt : Word;       {relocation item count}
  89.       Private : array[1..4] of Byte;
  90.     end;
  91.  {$ENDIF}
  92.  
  93.  
  94.   procedure DumpUnit(Name : string; var H : TpuHeader);
  95.     {-Dump unit information}
  96.   const
  97.     PlusMinus : array[Boolean] of Char = ('-', '+');
  98.   var
  99.     HasDebug, HasLocals, HasNumeric, HasOverlay : Boolean;
  100.   begin
  101.     with H do begin
  102.       HasDebug := (UnitSize > DebugPtr);
  103.       HasLocals := (DScopePtr > ScopePtr);
  104.       HasNumeric := (Flags and 1 <> 0);
  105.       HasOverlay := (Flags and 2 <> 0);
  106.  
  107.       if DebugOnly and not HasDebug then
  108.         Exit;
  109.       if LocalsOnly and not HasLocals then
  110.         Exit;
  111.       if NumericOnly and not HasNumeric then
  112.         Exit;
  113.       if OverlayOnly and not HasOverlay then
  114.         Exit;
  115.  
  116.       Write(Pad(JustName(Name), 10));
  117.     {$IFDEF Ver60}
  118.       if TPUsig <> SigForTPU60 then
  119.         WriteLn('is not a 6.0 TPU file')
  120.     {$ELSE}
  121.       if TPUsig <> SigForTPU55 then
  122.         WriteLn('is not a 5.5 TPU file')
  123.     {$ENDIF}
  124.       else begin
  125.         Write(  '$D', PlusMinus[HasDebug]);
  126.         Write(', $L', PlusMinus[HasLocals]);
  127.         Write(', $N', PlusMinus[HasNumeric]);
  128.         Write(', $O', PlusMinus[HasOverlay]);
  129.         Write(', ', CodeSize:5, ' code');
  130.         Write(', ', ConstSize+DataSize:5, ' data');
  131.         if ShowSymSize then
  132.           Write(', ', UnitSize:5, ' symbols');
  133.         WriteLn;
  134.       end;
  135.     end;
  136.   end;
  137.  
  138.   procedure ReadUnit(Path, FName : PathStr);
  139.     {-Read the TPU file}
  140.   var
  141.     F : File of TpuHeader;
  142.     H : TpuHeader;
  143.   begin
  144.     FName := AddBackslash(JustPathName(Path))+FName;
  145.     if JustExtension(FName) <> 'TPU' then
  146.       Exit;
  147.     Assign(F, FName);
  148.     Reset(F);
  149.     if IoResult <> 0 then begin
  150.       WriteLn('Error reading ', FName);
  151.       Exit;
  152.     end;
  153.     Read(F, H);
  154.     if IoResult <> 0 then
  155.       WriteLn('Error reading ', FName)
  156.     else
  157.       DumpUnit(FName, H);
  158.     Close(F);
  159.     if IoResult <> 0 then ;
  160.   end;
  161.  
  162.   procedure Help;
  163.     {-Display instructions}
  164.   begin
  165.     WriteLn('UNITINFO. Copyright (c) 1989,1990 TurboPower Software. Version 1.2.');
  166.     WriteLn;
  167.     WriteLn('Usage:');
  168.     WriteLn('  UNITINFO [Options] mask [mask] [mask]');
  169.     WriteLn;
  170.     WriteLn('Options:');
  171.     WriteLn('  /D   Show only files with $D+');
  172.     WriteLn('  /L   Show only files with $L+');
  173.     WriteLn('  /N   Show only files with $N+');
  174.     WriteLn('  /O   Show only files with $O+');
  175.     WriteLn('  /S   Show symbol table size');
  176.     WriteLn;
  177.     WriteLn('Examples:');
  178.     WriteLn('  UNITINFO myunit.tpu        single file');
  179.     WriteLn('  UNITINFO myunit            single file, .TPU assumed');
  180.     WriteLn('  UNITINFO *.tpu             multiple files');
  181.     WriteLn('  UNITINFO *                 multiple files, .TPU assumed');
  182.     WriteLn('  UNITINFO *.*               multiple files, same as *.TPU');
  183.     WriteLn('  UNITINFO *.tpu \dir\*.tpu  multiple masks');
  184.     WriteLn('  UNITINFO /D *.tpu          units without $D+ ignored');
  185.     WriteLn('  UNITINFO /D /L *.tpu       units without both $D+ and $L+ ignored');
  186.     WriteLn('                             (options must precede first mask)');
  187.     Halt(0);
  188.   end;
  189.  
  190. var
  191.   S : string;
  192.   I, E : Word;
  193.   SearchRecord : SearchRec;
  194. const
  195.   MaskCount : Word = 0;
  196. begin
  197.   if ParamCount = 0 then
  198.     Help;
  199.  
  200.   for I := 1 to ParamCount do begin
  201.     S := StUpcase(ParamStr(I));
  202.     if (S[1] = '-') or (S[1] = '/') then begin
  203.       if Length(S) > 2 then
  204.         WriteLn('Invalid option: ', S)
  205.       else case S[2] of
  206.         'D' : DebugOnly := True;
  207.         'L' : LocalsOnly := True;
  208.         'N' : NumericOnly := True;
  209.         'O' : OverlayOnly := True;
  210.         'S' : ShowSymSize := True;
  211.         else WriteLn('Invalid option: ', S);
  212.       end;
  213.     end
  214.     else begin
  215.       Inc(MaskCount);
  216.       if S = '.' then
  217.         S := '*'
  218.       else if S[Length(S)] = '\' then
  219.         S := S+'*'
  220.       else if IsDirectory(S) then
  221.         S := AddBackSlash(S)+'*';
  222.       S := DefaultExtension(S, 'TPU');
  223.       FindFirst(S, $6, SearchRecord);
  224.       E := IoResult;
  225.       if (DosError = 0) and (E = 0) then begin
  226.         ReadUnit(S, SearchRecord.Name);
  227.         {get the rest of the files}
  228.         while DosError = 0 do begin
  229.           FindNext(SearchRecord);
  230.           if DosError = 0 then
  231.             ReadUnit(S, SearchRecord.Name);
  232.         end;
  233.       end
  234.       else
  235.         WriteLn('No matching files found (', S, ')');
  236.     end;
  237.   end;
  238.   if MaskCount = 0 then
  239.     Help;
  240. end.
  241.